home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 501-525 / disk_517 / aequipot / source / aequipotn.p next >
Text File  |  1992-05-06  |  41KB  |  1,420 lines
  1. {-------------------------------------------------------------------------}
  2.  
  3. PROGRAM Aequipotential;
  4.  
  5. {--------------------------------------------------------------------------
  6.  
  7.                         Äquipotential V1.15 NTSC
  8.                  written by J.Matern December 23, 1990
  9.                       last changed June 28, 1991
  10.                          written in PCQ-Pascal
  11.                       Compiler:PCQ-Compiler V1.1c
  12.                                   //
  13.                 Written for the \X/ Amiga; tested on a
  14.                     PAL Amiga 2000, Rev4.1; KickV1.2
  15.  
  16.                   Thanx to my brother Markus who gave
  17.                      me help and some good ideas!
  18.  
  19. --------------------------------------------------------------------------}
  20.  
  21. {$I "Include:Ports.i"       : GetMsg, ReplyMsg, WaitPort }
  22. {$I "Include:Intuition.i"   : AutoRequest, CloseScreen, CloseWindow,
  23.                               ModifyIDCMP, OpenScreen, OpenWindow,
  24.                               ScreenToBack, ScreenToFront, ShowTitle,
  25.                               ViewPortAddress }
  26. {$I "Include:Graphics.i"    : Draw, Move, RectFill, SetAPen,
  27.                               SetDrMd, SetRGB4, WritePixel }
  28. {$I "Include:Exec.i"        : AllocMem, CloseLibrary, FindTask, Forbid,
  29.                               FreeMem, OpenLibrary, Permit }
  30. {$I "Include:Screen.i"      : Screen-Record Definition }
  31. {$I "Include:MathTrans.i"   : OpenMathTrans, CloseMathTrans, SPPow, SPSqrt }
  32. {$I "Include:Text.i"        : GText }
  33. {$I "Include:StringLib.i"   : AllocString, IntToString, stricmp, strcpy }
  34. {$I "Include:Parameters.i"  : GetParam, GetStartupMsg }
  35. {$I "Process.i"             : Process-Record }
  36. {$I "ILBM.i"                : SaveWindowToIFF }
  37. {$I "ReqLibrary.i"          : ColorRequester, FileRequester, GetLong}
  38.  
  39. {-------------------------------------------------------------------------}
  40.  
  41. TYPE
  42.    CrossType  = Array[0..33] of Short;   {für den neuen Mauszeiger}
  43.  
  44. {-------------------------------------------------------------------------}
  45.  
  46. CONST
  47.    Commands    = 8;
  48.    Ko          = 80.00;
  49.    MaxPot      = 15.00;
  50.    MaxLad      = 20;
  51.   {Skonst      = 256;      PAL  }
  52.    Skonst      = 200;    { NTSC }
  53.    RMBTRAP_f   = $10000; {fehlt in Intuition.i}
  54.    FPF_ROMFONT = 1;      {fehlt in Text.i}
  55.    FPF_TALLDOT = 8;      {fehlt in Text.i}
  56.  
  57.    EmptyStr: String    = "\0";
  58.    OK      : IntuiText = (0,0,JAM1,0,6,3,nil,"OK",nil);
  59.    Cancel  : IntuiText = (0,0,JAM1,0,7,3,nil,"Cancel",nil);
  60.    Repair  : IntuiText = (0,0,JAM1,0,16,8,nil,"Do you want to repair?",nil);
  61.    Feintxt : IntuiText = (0,0,JAM1,0,16,8,nil,"Re-Render in High-Quality?",nil);
  62.    NoReq   : IntuiText = (0,0,JAM1,0,16,8,nil,"Could not open Req.library!",nil);
  63.    NoMath  : IntuiText = (0,0,JAM1,0,16,8,nil,"Could not open Mathtrans.library!",nil);
  64.  
  65.    TOPAZ80 : TextAttr  = ("topaz.font",8,FS_NORMAL,FPF_ROMFONT + FPF_TALLDOT);
  66.  
  67.    NewScr  : NewScreen = (0,0,0,0,0,0,0,0,CUSTOMSCREEN_f,nil,
  68.                           "AequipotV1.15 © 1990/91 by J.Matern",nil,nil);
  69.  
  70.    NewWin  : NewWindow = (0,0,0,0,-1,-1,MOUSEBUTTONS_f,
  71.                           BACKDROP_f + BORDERLESS_f + SMART_REFRESH_f + ACTIVATE_f + REPORTMOUSE_f + RMBTRAP_f,
  72.                           nil,nil,nil,nil,nil,50,-1,20,-1,CUSTOMSCREEN_f);
  73.  
  74.    MyLong  : GetLongStruct = (nil,0,-20,20,0,nil,REQVERSION,0,0);
  75.  
  76.    SaveTit : Array [0..19] of char = 'Save Window as ILBM\0';
  77.    LadTit  : Array [0..13] of char = 'Enter Charge!\0';
  78.  
  79.    Command : Array[1..Commands] of String = ("Mode","Charge","AnimateStart",
  80.                           "AnimateEnd","Frames","Name","*","NextFile");
  81.  
  82.    CrossSt : CrossType =     ($0000, $0000,  {Die Daten für den}
  83.                                              {KREUZ-Mauszeiger}
  84.                               $0100, $0000,
  85.                               $0100, $0100,
  86.                               $0100, $0000,
  87.                               $0100, $0100,
  88.                               $0100, $0000,
  89.                               $0100, $0100,
  90.                               $0000, $0000,
  91.                               $FC7E, $5454,
  92.                               $0000, $0000,
  93.                               $0100, $0100,
  94.                               $0100, $0000,
  95.                               $0100, $0100,
  96.                               $0100, $0000,
  97.                               $0100, $0100,
  98.                               $0100, $0000,
  99.  
  100.                               $0000, $0000);
  101.  
  102. {-------------------------------------------------------------------------}
  103.  
  104. VAR
  105.    Name_f, Script_f,
  106.    AnGlob_f, AnStart_f,
  107.    Test_f, Screen_f,
  108.    Render_f, Minus_f,
  109.    Mathtest, NoHide,
  110.    MovedMouse, Quit,
  111.    Area, UpperLeft,
  112.    Rect, ReqFlag        : BOOLEAN;
  113.    Frames, PicNum,
  114.    Comm, CommLine,
  115.    x,y,xf,yf,xs,ys,
  116.    i,t,Fast,Leave,
  117.    Anzahl,Modeflag,
  118.    Whoehe,Wbreite,
  119.    Shoehe,Sbreite,Smode,
  120.    Minho,Minbr,Atf,
  121.    strlaeng,
  122.    LeftX, LeftY,
  123.    RightX, RightY,
  124.    Dummy, ILBMError     : INTEGER;
  125.    EPottest,Fak,Dist    : REAL;
  126.    Eingabe, Ausgabe     : TEXT;
  127.    Number, NameStore,
  128.    NextName, NextStore,
  129.    NameEin, NameAus,
  130.    ReadStr, DummyStr,
  131.    xkord, ykord, empty,
  132.    GrMode, SpMode       : STRING;
  133.    Anim_f               : ARRAY [0..MaxLad] OF BOOLEAN;
  134.    Rpktx,Rpkty          : ARRAY [0..4] OF INTEGER;
  135.    Apktx,Apkty,
  136.    Arbfeld,Arbb,Arbh    : ARRAY [0..8] OF INTEGER;
  137.    Anis,AnisX,AnisY,
  138.    Anie,AnieX,AnieY,
  139.    Lad,Ladx,Lady        : ARRAY [0..MaxLad] OF REAL;
  140.    Pottest              : ARRAY [0..4] OF REAL;
  141.    CrossData            : ^CrossType;
  142.  
  143.    MyFileReq            : ReqFileRequester;
  144.    Answerarray          : ARRAY [0..DSIZE+FCHARS] OF CHAR;
  145.    ReqFileName          : ARRAY [0..FCHARS] OF CHAR;
  146.    DirectoryName        : ARRAY [0..DSIZE] OF CHAR;
  147.  
  148.    s         : ScreenPtr;
  149.    bw ,qw    : WindowPtr;
  150.    rp        : RastPortPtr;
  151.    m         : MessagePtr;
  152.    vp        : Address;
  153.    IM        : IntuiMessagePtr;
  154.    StoreMsg  : IntuiMessage;
  155.    WBSP      : WBStartupPtr;
  156.    myprocess : ProcessPtr;
  157.    olderrorw : Address;
  158.  
  159. {-------------------------------------------------------------------------}
  160.  
  161. FUNCTION OpenMyScreen : BOOLEAN;
  162. BEGIN
  163.    NewScr.Font := ADR(TOPAZ80);
  164.    NewScr.Width := Sbreite;
  165.    NewScr.Height:= Shoehe;
  166.    NewScr.Depth := 3 + ModeFlag;
  167.    NewScr.DetailPen := TRUNC(16.0/Fak);
  168.    NewScr.ViewModes := Smode;
  169.    s := OpenScreen(ADR(NewScr));
  170.    OpenMyScreen := s <> nil;
  171. END;
  172.  
  173. {-------------------------------------------------------------------------}
  174.  
  175. FUNCTION OpenBackWindow : BOOLEAN;
  176. BEGIN
  177.    NewWin.Width := Wbreite;
  178.    NewWin.Height := Whoehe;
  179.    NewWin.Screen := s;
  180.    bw := OpenWindow(ADR(NewWin));
  181.    OpenBackWindow := bw <> nil;
  182. END;
  183.  
  184. {-------------------------------------------------------------------------}
  185.  
  186. PROCEDURE CloseAll;
  187. BEGIN
  188.    IF s <> nil THEN
  189.       ScreenToBack(s);
  190.  
  191.    IF bw <> nil THEN BEGIN
  192.       Forbid;
  193.       REPEAT
  194.          IM := IntuiMessagePtr(GetMsg(bw^.UserPort));
  195.          IF IM <> nil THEN ReplyMsg(MessagePtr(IM));
  196.       UNTIL IM = nil;
  197.       CloseWindow(bw);
  198.       Permit;
  199.    END;
  200.  
  201.    IF s <>nil THEN
  202.       CloseScreen(s);
  203.  
  204.    IF CrossData <> nil THEN
  205.       FreeMem(CrossData,MemChip);
  206.  
  207.    IF GfxBase <> nil THEN
  208.       CloseLibrary(GfxBase);
  209.  
  210.    IF Mathtest = TRUE THEN
  211.       CloseMathTrans;
  212.  
  213.    IF ILBMBase <> nil THEN
  214.       CloseLibrary(ILBMBase);
  215.  
  216.    IF ReqBase <> nil THEN BEGIN
  217.       PurgeFiles(ADR(MyFileReq));
  218.       CloseLibrary(ReqBase);
  219.    END;
  220.  
  221.    myprocess^.pr_WindowPtr := olderrorw;
  222. END;
  223.  
  224. {-------------------------------------------------------------------------}
  225.  
  226. PROCEDURE OpenMath;
  227. BEGIN
  228.    Mathtest := OpenMathTrans();
  229.    IF (NOT Mathtest) THEN BEGIN
  230.       ReqFlag := AutoRequest(nil,ADR(NoMath),nil,ADR(Ok),0,0,356,60);
  231.       CloseAll;
  232.       EXIT(20);
  233.    END;
  234. END;
  235.  
  236. {-------------------------------------------------------------------------}
  237.  
  238. PROCEDURE OpenAll;
  239. BEGIN
  240.    ReqBase := OpenLibrary("req.library", 0);
  241.    IF ReqBase = nil THEN BEGIN
  242.       ReqFlag := AutoRequest(nil,ADR(NoReq),nil,ADR(Ok),0,0,300,60);
  243.       CloseAll;
  244.       EXIT(20);
  245.    END;
  246.  
  247.    ILBMBase := OpenLibrary("ilbm.library", 0);
  248.    IF ILBMBase = nil THEN BEGIN
  249.       SimpleRequest("Could not open ILBM.library!");
  250.       CloseAll;
  251.       EXIT(20);
  252.    END;
  253.  
  254.    GfxBase := OpenLibrary("graphics.library", 0);
  255.    IF GfxBase = nil THEN BEGIN
  256.       SimpleRequest("Could not open Graphics.library!");
  257.       CloseAll;
  258.       EXIT(20);
  259.    END;
  260.  
  261.    IF (NOT OpenMyScreen) THEN BEGIN
  262.       SimpleRequest("Could not open the screen!");
  263.       CloseAll;
  264.       Exit(20);
  265.    END;
  266.    ShowTitle(s, FALSE);
  267.  
  268.    IF (NOT OpenBackWindow) THEN BEGIN
  269.       SimpleRequest("Could not open window!");
  270.       CloseAll;
  271.       Exit(20);
  272.    END;
  273.    rp:=bw^.RPort;
  274.    MyFileReq.window := bw;
  275.    MyLong.window := bw;
  276.  
  277.    myprocess := FindTask(nil);
  278.    olderrorw := myprocess^.pr_WindowPtr;
  279.    myprocess^.pr_WindowPtr := bw;
  280. END;
  281.  
  282. {-------------------------------------------------------------------------}
  283.  
  284. PROCEDURE InitFileReq;
  285. BEGIN
  286.    MyFileReq.PathName := ADR(Answerarray);
  287.    MyFileReq._Dir := ADR(DirectoryName);
  288.    MyFileReq._File := ADR(ReqFilename);
  289.    MyFileReq.Title := ADR(SaveTit);
  290.    MyFileReq.VersionNumber := REQVERSION;
  291.    MyFileReq.Flags := FRQCACHINGM;
  292.    MyFileReq.dirnamescolor := 2;
  293.    MyFileReq.devicenamescolor := 2;
  294. END;
  295.  
  296. {-------------------------------------------------------------------------}
  297.  
  298. FUNCTION Distance(x,y : REAL; xx,yy : INTEGER) : REAL;
  299. {Entfernungsbestimmung mit Pythagoras zwischen (x,y) u. (xx,yy)}
  300. BEGIN
  301.    Distance:=SPsqrt(SQR(x-FLOAT(xx))+SQR(y-FLOAT(yy)));
  302.    {SPsqrt ist viel schneller als SQRT!!}
  303. END;
  304.  
  305. {-------------------------------------------------------------------------}
  306.  
  307. FUNCTION Potential(Lad,Dist : REAL) : REAL;
  308. {Potentialbestimmung zur Ladung (Lad) in Entfernung (Dist)}
  309. BEGIN
  310.    Potential:=Ko*(Lad/Dist);
  311. END;
  312.  
  313. {-------------------------------------------------------------------------}
  314.  
  315. PROCEDURE SaveIFF;
  316. BEGIN
  317.    MyFileReq.Flags := FRQCACHINGM + FRQSAVINGM;
  318.    IF FileRequester(ADR(MyFileReq)) THEN BEGIN
  319.       ILBMError := SaveWindowToIFF(bw,ADR(Answerarray));
  320.    END;
  321. END;
  322.  
  323. {-------------------------------------------------------------------------}
  324.  
  325. PROCEDURE HandleMessage;
  326. BEGIN
  327.    IM := IntuiMessagePtr(WaitPort(bw^.UserPort));
  328.    IM := IntuiMessagePtr(GetMsg(bw^.UserPort));
  329.    StoreMsg := IM^;
  330.    ReplyMsg(MessagePtr(IM));
  331.    CASE StoreMsg.Class OF
  332.       VANILLAKEYS_f : BEGIN
  333.          CASE StoreMsg.Code OF
  334.             99 : ColorRequester(1);           {Taste c}
  335.            115 : SaveIFF;                     {Taste s}
  336.          END;
  337.       END;
  338.       MOUSEBUTTONS_f : BEGIN
  339.          IF StoreMsg.Code = SELECTUP THEN BEGIN
  340.             IF NoHide=TRUE THEN
  341.                NoHide:=FALSE
  342.             ELSE
  343.                NoHide:=TRUE;
  344.             ShowTitle(s, NoHide);
  345.          END;
  346.          IF StoreMsg.Code = MENUUP THEN BEGIN
  347.             Quit:=TRUE;
  348.          END;
  349.       END;
  350.    END;
  351. END;
  352.  
  353. {-------------------------------------------------------------------------}
  354.  
  355. PROCEDURE RechnePotential; {Potential an jedem der fünf Rechenpunkte wird
  356.                             berechnet=Pottest[0-4]}
  357. BEGIN
  358.    FOR t:=0 TO 4 DO BEGIN
  359.       Pottest[t]:=0.0;
  360.       FOR i:=1 TO Anzahl DO BEGIN
  361.          Dist:=Distance(Ladx[i],Lady[i],Rpktx[t],Rpkty[t]);
  362.          IF Dist<>0.0 THEN BEGIN
  363.             Pottest[t]:=Pottest[t]+Potential(Lad[i],Dist);
  364.          END ELSE
  365.             Pottest[t]:=100.0*Lad[i];
  366.       END;
  367.    END;
  368. END;
  369.  
  370. {-------------------------------------------------------------------------}
  371.  
  372. PROCEDURE Drawing(x,y : INTEGER); {Potential an x,y wird berechnet und
  373.                                    gezeichnet}
  374. BEGIN {Drawing}
  375.    EPottest:=0.0;
  376.    FOR i:=1 TO Anzahl DO BEGIN {Aufsummieren der Einzelpotentiale über
  377.                                 die verschiedenen Ladungen}
  378.       Dist:=Distance(Ladx[i],Lady[i],x,y);
  379.       IF Dist<>0.0 THEN BEGIN
  380.          EPottest:=EPottest+Potential(Lad[i],Dist);
  381.       END ELSE
  382.          Epottest:=100.0*Lad[i];
  383.    END;
  384.    IF ABS(EPottest)<MaxPot THEN BEGIN     {wenn Potential nicht zu groß}
  385.       SetAPen(rp,ROUND((EPottest+16.0)/Fak)); {dann Farbwahl und}
  386.       WritePixel(rp,x,y);                     {Setzen eines Punktes}
  387.    END;
  388. END; {Drawing}
  389.  
  390. {-------------------------------------------------------------------------}
  391.  
  392. PROCEDURE FastDraw(xsta, ysta, xe, ye, xste, yste : INTEGER; Modus : BOOLEAN);
  393.                         {Schneller Überblick über die Grafik}
  394.                         {oder Reperatur, je nach Modus}
  395. BEGIN {FastDraw}
  396.    y:=ysta;
  397.    REPEAT
  398.    {Schleife für y-Koordinate}
  399.       x:=xsta;
  400.       REPEAT
  401.       {Schleife für x-Koordinate}
  402.          EPottest:=0.0;
  403.          m:=GetMsg(bw^.UserPort);
  404.          IF m <> nil THEN BEGIN {Abbruch bei Mausknopf}
  405.             HandleMessage;
  406.             IF Quit=TRUE THEN BEGIN
  407.                x:=xe+1;
  408.                y:=ye+1;
  409.             END;
  410.          END;
  411.          FOR i:=1 TO Anzahl DO BEGIN    {Potential Aufsummieren}
  412.             Dist:=Distance(Ladx[i],Lady[i],x,y);
  413.             IF Dist<>0.0 THEN BEGIN
  414.                EPottest:=EPottest+Potential(Lad[i],Dist);
  415.             END ELSE
  416.                EPottest:=100.0*Lad[i];
  417.          END;
  418.          IF ABS(EPottest)<MaxPot THEN BEGIN {falls Potential nicht zu groß}
  419.             SetAPen(rp,ROUND((EPottest+16.0)/Fak)); {dann Farbwahl und}
  420.             IF Modus THEN
  421.                WritePixel(rp,x,y)                       {Punkt setzen}
  422.             ELSE                                        {oder}
  423.                RectFill(rp,x,y,x+xste,y+yste+1);        {Fläche füllen}
  424.          END;
  425.          x:=x+xste;
  426.       UNTIL x >= xe; {Schleifenende x}
  427.       y:=y+yste;
  428.    UNTIL y >= ye; {Schleifenende y}
  429. END; {FastDraw}
  430.  
  431. {-------------------------------------------------------------------------}
  432.  
  433. PROCEDURE Clear; {Window löschen}
  434. BEGIN
  435.    SetAPen(rp,0);
  436.    RectFill(rp,0,0,Sbreite,Shoehe);
  437.    SetAPen(rp,TRUNC(16.0/Fak));
  438. END;
  439.  
  440. {-------------------------------------------------------------------------}
  441.  
  442. PROCEDURE Cross(x,y : INTEGER); {Zeichnet Kreuz bei x,y}
  443. BEGIN
  444.    MOVE(rp,x-2,y);
  445.    DRAW(rp,x+2,y);
  446.    MOVE(rp,x,y-2);
  447.    DRAW(rp,x,y+2);
  448. END;
  449.  
  450. {-------------------------------------------------------------------------}
  451.  
  452. PROCEDURE LadMark; {Übergibt Koordinaten jeder Ladung an Cross}
  453. BEGIN
  454.    Clear;
  455.    FOR i:=1 TO Anzahl DO BEGIN
  456.       x:=TRUNC(Ladx[i]);
  457.       y:=TRUNC(Lady[i]);
  458.       Cross(x,y);
  459.    END;
  460. END;
  461.  
  462. {-------------------------------------------------------------------------}
  463.  
  464. PROCEDURE Color; {Farbpalette wird in Abhängigkeit von ScreenAuflösung
  465.                   gesetzt}
  466. BEGIN {Color}
  467.    vp:= ViewPortAddress(bw);
  468.    IF ModeFlag=2 THEN BEGIN
  469.       SetRGB4(vp, 0, 0, 0, 0);
  470.       FOR i:=1 TO 16 DO
  471.          SetRGB4(vp, i,15, i-1,0);
  472.       FOR i:=16 TO 31 DO
  473.          SetRGB4(vp, i,31-i,31-i,i-16);
  474.    END ELSE BEGIN
  475.       SetRGB4(vp, 0, 0, 0, 0);
  476.       FOR i:=1 TO 8 DO
  477.          SetRGB4(vp,i,15,i*2-1,0);
  478.       FOR i:=8 TO 15 DO
  479.          SetRGB4(vp, i,31-2*i,31-2*i,i*2-16);
  480.    END;
  481.    SetAPen(rp,TRUNC(16.0/Fak));
  482. END; {Color}
  483.  
  484. {-------------------------------------------------------------------------}
  485.  
  486. PROCEDURE Pointtest; {Berechnung von fünf Probekoordinaten in Abhängigkeit
  487.                       vom Arbeitspunkt; Berechnung des Potentials an den
  488.                       fünf Rechenpunkten; je nach Ergebnis Füllen der
  489.                       Fläche, Veränderung der Arbeitstiefe (Atf) und des
  490.                       Arbeitsbereichs}
  491. BEGIN {Pointtest}
  492.    Rpktx[0]:=Apktx[Atf]; {Berechnung der Probekoordinaten}
  493.    Rpkty[0]:=Apkty[Atf];
  494.    Rpktx[1]:=Apktx[Atf]+Arbb[Atf]-1;
  495.    Rpkty[1]:=Apkty[Atf];
  496.    Rpktx[2]:=Apktx[Atf];
  497.    Rpkty[2]:=Apkty[Atf]+Arbh[Atf]-1;
  498.    Rpktx[3]:=Apktx[Atf]+Arbb[Atf]-1;
  499.    Rpkty[3]:=Apkty[Atf]+Arbh[Atf]-1;
  500.    Rpktx[4]:=Apktx[Atf]+Arbb[Atf+1]-1;
  501.    Rpkty[4]:=Apkty[Atf]+Arbh[Atf+1]-1;
  502.    RechnePotential; {Berechnung des Potentials an den fünf Punkten}
  503.    IF (ROUND(Pottest[0]/Fak)=ROUND(Pottest[1]/Fak)) AND
  504.     (ROUND(Pottest[1]/Fak)=ROUND(Pottest[2]/Fak)) AND
  505.     (ROUND(Pottest[2]/Fak)=ROUND(Pottest[3]/Fak)) AND
  506.     (ROUND(Pottest[3]/Fak)=ROUND(Pottest[4]/Fak)) THEN BEGIN {Falls das
  507.                         Potential an allen fünf Punkten identisch ist}
  508.       IF ABS(Pottest[0])<MaxPot THEN BEGIN
  509.          SetAPen(rp,ROUND((Pottest[0]+16.0)/Fak)); {dann Farbauswahl und}
  510.          RectFill(rp,Rpktx[0],Rpkty[0],Rpktx[3],Rpkty[3]); {Füllen der
  511.                                           entsprechenden Fläche}
  512.       END;
  513. {*}   IF Arbfeld[Atf]=5 THEN BEGIN {Test, ob momentane Arbeitstiefe schon
  514.                           vollständig bearbeitet wurde}
  515.          REPEAT
  516.             Arbfeld[Atf]:=1;       {dann Arbeitstiefe verringern}
  517.             DEC(Atf);
  518.          UNTIL Arbfeld[Atf]<5;
  519.       END ELSE
  520.          INC(Arbfeld[Atf]); {sonst Arbeitsbereich erhöhen}
  521.    END ELSE BEGIN                 {wenn Fläche nicht gefüllt werden konnte,}
  522.       IF (Atf=8) THEN BEGIN       {maximale Arbeitstiefe erreicht ist}
  523.          IF (ABS(Pottest[0]/Fak)<Maxpot) OR
  524.           (ABS(Pottest[1]/Fak)<Maxpot) OR
  525.           (ABS(Pottest[2]/Fak)<Maxpot) OR
  526.           (ABS(Pottest[3]/Fak)<Maxpot) THEN BEGIN {und Fläche nicht schwarz}
  527.             FOR x:=Rpktx[0] TO Rpktx[3] DO BEGIN     {wird Fläche Pixel}
  528.                FOR y:=Rpkty[0] TO Rpkty[3] DO BEGIN  {für Pixel berechnet}
  529.                   Drawing(x,y);
  530.                END;
  531.             END;
  532.          END;
  533.          IF Arbfeld[Atf]=5 THEN BEGIN {siehe *}
  534.             REPEAT
  535.                Arbfeld[Atf]:=1;
  536.                DEC(Atf);
  537.             UNTIL Arbfeld[Atf]<5;
  538.          END ELSE
  539.             INC(Arbfeld[Atf]);
  540.       END ELSE BEGIN    {Fläche konnte nicht gefüllt werden, maximale
  541.                          Arbeitstiefe ist aber noch nicht erreicht}
  542.          IF Arbfeld[Atf]=5 THEN
  543.             Arbfeld[Atf]:=1
  544.          ELSE
  545.             INC(Arbfeld[Atf]);
  546.          INC(Atf);    {Arbeitstiefe erhöhen}
  547.       END;
  548.    END;
  549. END; {Pointtest}
  550.  
  551. {-------------------------------------------------------------------------}
  552.  
  553. PROCEDURE Areatest; {Test, in welchem der vier möglichen Arbeitsbereiche
  554.                      momentan gerade gerechnet wird und entsprechende Wahl
  555.                      des Arbeitpunktes (Apktx,Apkty) der momentanen
  556.                      Arbeitstiefe (Atf)}
  557. BEGIN {Areatest}
  558.    REPEAT
  559.       CASE Arbfeld[Atf] OF
  560.          1 : BEGIN  {Bereich 1=links oben}
  561.             xf:=0;
  562.             yf:=0;
  563.          END;
  564.          2 : BEGIN  {Bereich 2=rechts oben}
  565.             xf:=1;
  566.             yf:=0;
  567.          END;
  568.          3 : BEGIN  {Bereich 3=links unten}
  569.             xf:=0;
  570.             yf:=1;
  571.          END;
  572.          ELSE BEGIN {Bereich 4=rechts unten}
  573.             xf:=1;
  574.             yf:=1;
  575.          END;
  576.       END;
  577.       Apktx[Atf]:=Apktx[Atf-1]+xf*Arbb[Atf]; {Berechnung des neuen}
  578.       Apkty[Atf]:=Apkty[Atf-1]+yf*Arbh[Atf]; {Arbeitpunktes in Tiefe Atf}
  579.       Pointtest;
  580.       Leave:=Apktx[Atf]+Arbb[Atf];
  581.       m:=GetMsg(bw^.UserPort); {Test auf linke Maustaste}
  582.       IF m <> nil THEN BEGIN
  583.          HandleMessage;
  584.          IF Quit=TRUE THEN               {und verlassen zum Hauptprogramm}
  585.             Leave:=(640 DIV Modeflag)+1; {falls diese gedrückt wurde}
  586.       END;
  587.    UNTIL Leave>(640 DIV ModeFlag); {Test, ob der gesamte
  588.                                     Bildschirm bereits
  589.                                     berechnet wurde}
  590. END; {Areatest}
  591.  
  592. {-------------------------------------------------------------------------}
  593.  
  594. PROCEDURE LadKoord;
  595. BEGIN
  596.    ModifyIDCMP(bw, MOUSEBUTTONS_f + MOUSEMOVE_f);
  597.    Quit:=FALSE;
  598.    MovedMouse:=FALSE;
  599.    Anzahl:=0;
  600.    Move(rp,(Sbreite-296) DIV 2,Shoehe DIV 2);
  601.    GText(rp,"Mit linkem Mausknopf Ladungen setzen,",37);
  602.    Move(rp,(Sbreite-240) DIV 2,(Shoehe DIV 2)+10);
  603.    GText(rp,"mit rechtem Mausknopf beenden!",30);
  604.    REPEAT
  605.       IM := IntuiMessagePtr(WaitPort(bw^.UserPort));
  606.       IM := IntuiMessagePtr(GetMsg(bw^.UserPort));
  607.       StoreMsg := IM^;
  608.       ReplyMsg(MessagePtr(IM));
  609.          CASE StoreMsg.Class OF
  610.          MOUSEMOVE_f : BEGIN
  611.             IF MovedMouse=FALSE THEN BEGIN
  612.                Clear;
  613.                MovedMouse:=TRUE;
  614.             END ELSE BEGIN
  615.                x:=StoreMsg.MouseX;
  616.                y:=StoreMsg.MouseY;
  617.                strlaeng:=IntToStr(xkord,x);
  618.                Move(rp,Sbreite-25,Shoehe-12);
  619.                Gtext(rp, empty, 3);
  620.                Move(rp,Sbreite-25,Shoehe-12);
  621.                Gtext(rp, xkord, strlaeng);
  622.                strlaeng:=IntToStr(ykord,y);
  623.                Move(rp,Sbreite-25,Shoehe-2);
  624.                Gtext(rp, empty, 3);
  625.                Move(rp,Sbreite-25,Shoehe-2);
  626.                Gtext(rp, ykord, strlaeng);
  627.             END;
  628.          END;
  629.          MOUSEBUTTONS_f : BEGIN
  630.             IF (StoreMsg.Code = SELECTUP) AND
  631.             (MovedMouse=TRUE) THEN BEGIN {linker Mausknopf}
  632.                INC(Anzahl);
  633.                x:=StoreMsg.MouseX;
  634.                y:=StoreMsg.MouseY;
  635.                Cross(x,y);
  636.                Ladx[Anzahl]:=FLOAT(x);
  637.                Lady[Anzahl]:=FLOAT(y);
  638.             END;
  639.             IF StoreMsg.Code = MENUUP THEN BEGIN   {rechter Mausknopf}
  640.                Quit:=TRUE;
  641.             END;
  642.          END;
  643.       END;
  644.    UNTIL ((Quit=TRUE) OR (Anzahl=MaxLad)) AND (Anzahl>0);
  645.    ModifyIDCMP(bw, MOUSEBUTTONS_f);
  646.    Quit:=FALSE;
  647. END;
  648.  
  649. {-------------------------------------------------------------------------}
  650.  
  651. PROCEDURE LadGet;
  652. BEGIN
  653.    SetRGB4(vp, 2, 0, 0, 10);
  654.    MyLong.titlebar := ADR(LadTit);
  655.    FOR t := 1 TO Anzahl DO BEGIN
  656.       SetAPen(rp,TRUNC(16.0/Fak));
  657.       DrawCircle(rp,TRUNC(Ladx[t]),TRUNC(Lady[t]),5);
  658.       IF t = 1 THEN
  659.          MyLong.defaultval := 5
  660.       ELSE
  661.          MyLong.defaultval := TRUNC(Lad[t-1]);
  662.       IF (GetLong(ADR(MyLong))) THEN
  663.          Lad[t] := FLOAT(MyLong.result);
  664.       SetAPen(rp,0);
  665.       DrawCircle(rp,TRUNC(Ladx[t]),TRUNC(Lady[t]),5);
  666.    END;
  667.    Color;
  668. END;
  669.  
  670. {-------------------------------------------------------------------------}
  671.  
  672. PROCEDURE Usage;
  673. BEGIN
  674.    WRITELN('Usage: AEQUIPOT [ScriptFile] OR [ScreenMode RenderingMode]');
  675.    WRITELN('       Where ScreenMode is h(igh) or l(ow)');
  676.    WRITELN('       and RenderingMode is s(low) or f(ast)');
  677.    WRITELN('       and ScriptFile is name of file to start from.');
  678.    WRITELN;
  679.    EXIT(20);
  680. END;
  681.  
  682. {-------------------------------------------------------------------------}
  683.  
  684. PROCEDURE RectArea;   {Zeichnet Rechteck (LeftX,LeftY/RightX,RightY)}
  685. BEGIN
  686.    Move(rp, LeftX, LeftY);
  687.    Draw(rp, RightX, LeftY);
  688.    Draw(rp, RightX, RightY);
  689.    Draw(rp, LeftX, RightY);
  690.    Draw(rp, LeftX, LeftY);
  691. END;
  692.  
  693. {-------------------------------------------------------------------------}
  694.  
  695. PROCEDURE SetRepArea;
  696. BEGIN
  697.    ModifyIDCMP(bw, MOUSEMOVE_f + MOUSEBUTTONS_f);
  698.    SetDrMd(rp, COMPLEMENT);
  699.    Rect:=FALSE;
  700.    UpperLeft:=FALSE;
  701.    Area:=FALSE;
  702.    REPEAT
  703.       IM := IntuiMessagePtr(WaitPort(bw^.UserPort));
  704.       IM := IntuiMessagePtr(GetMsg(bw^.UserPort));
  705.       StoreMsg := IM^;
  706.       ReplyMsg(MessagePtr(IM));
  707.          CASE StoreMsg.Class OF
  708.          MOUSEMOVE_f : BEGIN
  709.             IF UpperLeft=TRUE THEN BEGIN
  710.                RectArea;
  711.                RightX := (StoreMsg.MouseX DIV 5)*5+4;
  712.                RightY := (StoreMsg.MouseY DIV 4)*4+3;
  713.                RectArea;
  714.             END;
  715.          END;
  716.          MOUSEBUTTONS_f : BEGIN
  717.             IF (StoreMsg.Code = SELECTUP) THEN BEGIN    {linker Mausknopf}
  718.                IF UpperLeft THEN BEGIN                  {zum 2. mal}
  719.                   UpperLeft:=FALSE;
  720.                   RightX := (StoreMsg.MouseX DIV 5)*5+4;
  721.                   RightY := (StoreMsg.MouseY DIV 4)*4+3;
  722.                END ELSE BEGIN                           {zum 1. mal}
  723.                   IF Rect = TRUE THEN                   {wenn Umrandung da}
  724.                      RectArea;                          {diese löschen}
  725.                   UpperLeft := TRUE;
  726.                   Rect := TRUE;
  727.                   LeftX := (StoreMsg.MouseX DIV 5)*5;
  728.                   LeftY := (StoreMsg.MouseY DIV 4)*4;
  729.                   RightX := LeftX;
  730.                   RightY := LeftY;
  731.                   RectArea;
  732.                END;
  733.             END;
  734.             IF (StoreMsg.Code = MENUUP) AND
  735.              (UpperLeft = FALSE) AND
  736.              (Rect = TRUE) THEN BEGIN {rechter Mausknopf u. Bereich gewählt}
  737.                RectArea;
  738.                Area:=TRUE;
  739.             END;
  740.          END;
  741.       END;
  742.    UNTIL Area=TRUE;
  743.    ModifyIDCMP(bw, MOUSEBUTTONS_f);
  744.    SetDrMd(rp, JAM1);
  745. END;
  746.  
  747. {-------------------------------------------------------------------------}
  748.  
  749. PROCEDURE RepairArea; {reparieren der Grafik}
  750. BEGIN
  751.    IF RightX < LeftX THEN BEGIN
  752.       Dummy := LeftX;
  753.       LeftX := RightX;
  754.       RightX:= Dummy;
  755.    END;
  756.    IF RightY < LeftY THEN BEGIN
  757.       Dummy := LeftY;
  758.       LeftY := RightY;
  759.       RightY:= Dummy;
  760.    END;
  761.    FastDraw(LeftX,LeftY,RightX,RightY,1,1,TRUE);
  762. END;
  763.  
  764. {-------------------------------------------------------------------------}
  765.  
  766. PROCEDURE Error (ComStr : String; Lin, Num : Short);
  767. BEGIN
  768.    WRITELN('Error in line ',Lin,': "',ComStr,'"');
  769.    CASE Num OF
  770.       1 : WRITELN('Unknown Command');
  771.       2 : WRITELN('Unknown Parameter');
  772.       3 : WRITELN('Too many charges, max = ',MaxLad);
  773.       4 : WRITELN('Parameter is missing');
  774.       5 : WRITELN('Expecting + or -');
  775.       6 : WRITELN('Parameter too large');
  776.       7 : WRITELN('Missing AnimateStart');
  777.       8 : WRITELN('Missing AnimateEnd');
  778.       9 : WRITELN('Missing Frames');
  779.      10 : WRITELN('Missing Animation');
  780.      11 : WRITELN('No Name spezified');
  781.      12 : WRITELN('Frames must be larger than 1');
  782.      13 : WRITELN('Duplicate Frames');
  783.      14 : WRITELN('No Charge spezified');
  784.      15 : WRITELN('No Mode spezified');
  785.      16 : WRITELN('Could not open file');
  786.    END;
  787.    CloseAll;
  788.    Close(Eingabe);
  789.    EXIT(10);
  790. END;
  791.  
  792. {-------------------------------------------------------------------------}
  793.  
  794. PROCEDURE TestPar;
  795. BEGIN
  796.    IF i = Dummy THEN
  797.       Error(ReadStr,CommLine,4);
  798. END;
  799.  
  800. {-------------------------------------------------------------------------}
  801.  
  802. FUNCTION StrToInt(st : String) : INTEGER;
  803. VAR
  804.    Ret,t : Short;
  805.  
  806. BEGIN
  807.    Ret := 0;
  808.    IF StrLen(st) > 3 THEN
  809.       Error(ReadStr,CommLine,6);
  810.    FOR t := StrLen(st)-1 DOWNTO 0 DO BEGIN
  811.       Ret := Ret + ((ORD(st[t])-48)*ROUND(SPPow(FLOAT(Strlen(st)-t-1),10.0)));
  812.    END;
  813.    IF Minus_f THEN
  814.       StrToInt := (-1) * Ret
  815.    ELSE
  816.       StrToInt := Ret
  817. END;
  818.  
  819. {-------------------------------------------------------------------------}
  820.  
  821. PROCEDURE ModeCheck(ComStr : String);
  822. BEGIN
  823.    Dummy := StrPos(ComStr,' ');
  824.    IF Dummy = -1 THEN
  825.       Error(ComStr,CommLine,4);
  826.    i := Dummy;
  827.    REPEAT
  828.       IF isalpha(ComStr[i]) THEN BEGIN
  829.          IF ((ComStr[i] = 'h') OR (ComStr[i] = 'H') OR
  830.             (ComStr[i] = 'l') OR (ComStr[i] = 'L')) AND
  831.             (Screen_f = FALSE) THEN BEGIN
  832.             IF (ComStr[i] = 'l') OR (ComStr[i] = 'L') THEN
  833.                Smode := 1
  834.             ELSE
  835.                Smode := 2;
  836.             Screen_f := TRUE;
  837.          END;
  838.          IF ((ComStr[i] = 'f') OR (ComStr[i] = 'F') OR
  839.             (ComStr[i] = 's') OR (ComStr[i] = 'S')) AND
  840.             (Render_f = FALSE) THEN BEGIN
  841.             IF (ComStr[i] = 'f') OR (ComStr[i] = 'F') THEN
  842.                Fast := 1
  843.             ELSE
  844.                Fast := 2;
  845.             Render_f := TRUE;
  846.          END;
  847.       END;
  848.    INC(i);
  849.    UNTIL i = strlen(ComStr);
  850.    IF (NOT Screen_f) OR (NOT Render_f) THEN
  851.       Error(ComStr,CommLine,4);
  852. END;
  853.  
  854. {-------------------------------------------------------------------------}
  855.  
  856. PROCEDURE ChargeCheck(ComStr : String);
  857. BEGIN
  858.    IF Anzahl = MaxLad+1 THEN
  859.       Error(ComStr,CommLine,3);
  860.    Dummy := StrPos(ComStr,' ');
  861.    IF Dummy = -1 THEN
  862.       Error(ComStr,CommLine,4);
  863.    i := Dummy;
  864.    Dummy := strlen(ComStr);
  865.    WHILE NOT isdigit(ComStr[i]) DO BEGIN
  866.       TestPar;
  867.       INC(i);
  868.    END;
  869.    Number := StrDup(EmptyStr);
  870.    t := 0;
  871.    WHILE isdigit(ComStr[i]) DO BEGIN
  872.       TestPar;
  873.       Number[t] := ComStr[i];
  874.       INC(t);
  875.       INC(i);
  876.    END;
  877.    LadX[Anzahl] := FLOAT(StrToInt(Number));
  878.    WHILE NOT isdigit(ComStr[i]) DO BEGIN
  879.       TestPar;
  880.       INC(i);
  881.    END;
  882.    Number := StrDup(EmptyStr);
  883.    t := 0;
  884.    WHILE isdigit(ComStr[i]) DO BEGIN
  885.       TestPar;
  886.       Number[t] := ComStr[i];
  887.       INC(t);
  888.       INC(i);
  889.    END;
  890.    LadY[Anzahl] := FLOAT(StrToInt(Number));
  891.    WHILE isspace(ComStr[i]) DO BEGIN
  892.       TestPar;
  893.       INC(i);
  894.    END;
  895.    IF (ComStr[i] <> '+') AND (ComStr[i] <> '-') THEN
  896.       Error(ComStr,CommLine,5);
  897.    IF (ComStr[i] = '+') THEN
  898.       Minus_f := FALSE
  899.    ELSE
  900.       Minus_f := TRUE;
  901.    INC(i);
  902.    Number := StrDup(EmptyStr);
  903.    t := 0;
  904.    WHILE isdigit(ComStr[i]) DO BEGIN
  905.       TestPar;
  906.       Number[t] := ComStr[i];
  907.       INC(t);
  908.       INC(i);
  909.    END;
  910.    IF t = 0 THEN
  911.       Error(ReadStr,CommLine,4);
  912.    Lad[Anzahl] := FLOAT(StrToInt(Number));
  913.    Anim_f[Anzahl] := FALSE;
  914.    INC(Anzahl);
  915.    Minus_f := FALSE;
  916.    AnStart_f := FALSE;
  917. END;
  918.  
  919. {-------------------------------------------------------------------------}
  920.  
  921. PROCEDURE AniStartCheck(ComStr : String);
  922. BEGIN
  923.    AnGlob_f := TRUE;
  924.    IF AnStart_f THEN
  925.       Error(ComStr,CommLine,8);
  926.    AnStart_f := TRUE;
  927.    IF Anzahl = MaxLad+1 THEN
  928.       Error(ComStr,CommLine,3);
  929.    Dummy := StrPos(ComStr,' ');
  930.    IF Dummy = -1 THEN
  931.       Error(ComStr,CommLine,4);
  932.    i := Dummy;
  933.    Dummy := strlen(ComStr);
  934.    WHILE NOT isdigit(ComStr[i]) DO BEGIN
  935.       TestPar;
  936.       INC(i);
  937.    END;
  938.    Number := StrDup(EmptyStr);
  939.    t := 0;
  940.    WHILE isdigit(ComStr[i]) DO BEGIN
  941.       TestPar;
  942.       Number[t] := ComStr[i];
  943.       INC(t);
  944.       INC(i);
  945.    END;
  946.    AnisX[Anzahl] := FLOAT(StrToInt(Number));
  947.    WHILE NOT isdigit(ComStr[i]) DO BEGIN
  948.       TestPar;
  949.       INC(i);
  950.    END;
  951.    Number := StrDup(EmptyStr);
  952.    t := 0;
  953.    WHILE isdigit(ComStr[i]) DO BEGIN
  954.       TestPar;
  955.       Number[t] := ComStr[i];
  956.       INC(t);
  957.       INC(i);
  958.    END;
  959.    AnisY[Anzahl] := FLOAT(StrToInt(Number));
  960.    WHILE isspace(ComStr[i]) DO BEGIN
  961.       TestPar;
  962.       INC(i);
  963.    END;
  964.    IF (ComStr[i] <> '+') AND (ComStr[i] <> '-') THEN
  965.       Error(ComStr,CommLine,5);
  966.    IF (ComStr[i] = '+') THEN
  967.       Minus_f := FALSE
  968.    ELSE
  969.       Minus_f := TRUE;
  970.    INC(i);
  971.    Number := StrDup(EmptyStr);
  972.    t := 0;
  973.    WHILE isdigit(ComStr[i]) DO BEGIN
  974.       TestPar;
  975.       Number[t] := ComStr[i];
  976.       INC(t);
  977.       INC(i);
  978.    END;
  979.    IF t = 0 THEN
  980.       Error(ReadStr,CommLine,4);
  981.    Anis[Anzahl] := FLOAT(StrToInt(Number));
  982.    Minus_f := FALSE;
  983. END;
  984.  
  985. {-------------------------------------------------------------------------}
  986.  
  987. PROCEDURE AniEndCheck(ComStr : String);
  988. BEGIN
  989.    IF NOT AnStart_f THEN
  990.       Error(ComStr,CommLine,7);
  991.    AnStart_f := FALSE;
  992.    Dummy := StrPos(ComStr,' ');
  993.    IF Dummy = -1 THEN
  994.       Error(ComStr,CommLine,4);
  995.    i := Dummy;
  996.    Dummy := strlen(ComStr);
  997.    WHILE NOT isdigit(ComStr[i]) DO BEGIN
  998.       TestPar;
  999.       INC(i);
  1000.    END;
  1001.    Number := StrDup(EmptyStr);
  1002.    t := 0;
  1003.    WHILE isdigit(ComStr[i]) DO BEGIN
  1004.       TestPar;
  1005.       Number[t] := ComStr[i];
  1006.       INC(t);
  1007.       INC(i);
  1008.    END;
  1009.    AnieX[Anzahl] := FLOAT(StrToInt(Number));
  1010.    WHILE NOT isdigit(ComStr[i]) DO BEGIN
  1011.       TestPar;
  1012.       INC(i);
  1013.    END;
  1014.    Number := StrDup(EmptyStr);
  1015.    t := 0;
  1016.    WHILE isdigit(ComStr[i]) DO BEGIN
  1017.       TestPar;
  1018.       Number[t] := ComStr[i];
  1019.       INC(t);
  1020.       INC(i);
  1021.    END;
  1022.    AnieY[Anzahl] := FLOAT(StrToInt(Number));
  1023.    WHILE isspace(ComStr[i]) DO BEGIN
  1024.       TestPar;
  1025.       INC(i);
  1026.    END;
  1027.    IF (ComStr[i] <> '+') AND (ComStr[i] <> '-') THEN
  1028.       Error(ComStr,CommLine,5);
  1029.    IF (ComStr[i] = '+') THEN
  1030.       Minus_f := FALSE
  1031.    ELSE
  1032.       Minus_f := TRUE;
  1033.    INC(i);
  1034.    Number := StrDup(EmptyStr);
  1035.    t := 0;
  1036.    WHILE isdigit(ComStr[i]) DO BEGIN
  1037.       TestPar;
  1038.       Number[t] := ComStr[i];
  1039.       INC(t);
  1040.       INC(i);
  1041.    END;
  1042.    IF t = 0 THEN
  1043.       Error(ReadStr,CommLine,4);
  1044.    Anie[Anzahl] := FLOAT(StrToInt(Number));
  1045.    Minus_f := FALSE;
  1046.    Anim_f[Anzahl] := TRUE;
  1047.    INC(Anzahl);
  1048. END;
  1049.  
  1050. {-------------------------------------------------------------------------}
  1051.  
  1052. PROCEDURE FrameCheck(ComStr : String);
  1053. BEGIN
  1054.    IF Frames <> 1 THEN
  1055.       Error(ComStr,CommLine,13);
  1056.    IF NOT AnGlob_f THEN
  1057.       Error(ComStr,CommLine,10);
  1058.    Dummy := StrPos(ComStr,' ');
  1059.    IF Dummy = -1 THEN
  1060.       Error(ComStr,CommLine,4);
  1061.    i := Dummy;
  1062.    Dummy := strlen(ComStr);
  1063.    WHILE NOT isdigit(ComStr[i]) DO BEGIN
  1064.       TestPar;
  1065.       INC(i);
  1066.    END;
  1067.    Number := StrDup(EmptyStr);
  1068.    t := 0;
  1069.    WHILE isdigit(ComStr[i]) DO BEGIN
  1070.       TestPar;
  1071.       Number[t] := ComStr[i];
  1072.       INC(t);
  1073.       INC(i);
  1074.    END;
  1075.    Frames := StrToInt(Number);
  1076.    IF Frames < 2 THEN
  1077.       Error(ComStr,CommLine,12);
  1078. END;
  1079.  
  1080. {-------------------------------------------------------------------------}
  1081.  
  1082. PROCEDURE NameCheck(ComStr : String);
  1083. BEGIN
  1084.    IF (Frames = 1) AND (AnGlob_f) THEN
  1085.       Error("Global",0,9);
  1086.    Name_f := TRUE;
  1087.    Dummy := StrPos(ComStr,' ');
  1088.    IF Dummy = -1 THEN
  1089.       Error(ComStr,CommLine,4);
  1090.    i := Dummy;
  1091.    Dummy := strlen(ComStr);
  1092.    WHILE isspace(ComStr[i]) DO BEGIN
  1093.       TestPar;
  1094.       INC(i);
  1095.    END;
  1096.    FOR t := i TO StrLen(ComStr) DO BEGIN
  1097.       NameAus[t-i] := ComStr[t];
  1098.       Answerarray[t-i] := ComStr[t];
  1099.    END;
  1100.    IF AnGlob_f THEN BEGIN
  1101.       NameStore := StrDup(NameAus);
  1102.       Dummy := IntToStr(DummyStr,Frames);
  1103.       StrCat(NameAus,DummyStr);
  1104.    END;
  1105.    Answerarray[t-i+1] := '\0';
  1106.    IF NOT Open(NameAus,Ausgabe) THEN
  1107.       Error(NameAus,CommLine,16)
  1108.    ELSE
  1109.       CLOSE(Ausgabe);
  1110. END;
  1111.  
  1112. {-------------------------------------------------------------------------}
  1113.  
  1114. PROCEDURE NextCheck(ComStr : String); {Noch nicht implementiert}
  1115. BEGIN
  1116. END;
  1117.  
  1118. {-------------------------------------------------------------------------}
  1119.  
  1120. PROCEDURE ComPara(Num : Short; ComStr : String);
  1121. BEGIN
  1122.    CASE Num OF
  1123.       1 : ModeCheck(ComStr);
  1124.       2 : ChargeCheck(ComStr);
  1125.       3 : AniStartCheck(ComStr);
  1126.       4 : AniEndCheck(ComStr);
  1127.       5 : FrameCheck(ComStr);
  1128.       6 : NameCheck(ComStr);
  1129.       7 : ;
  1130.       8 : NextCheck(ComStr);
  1131.    END;
  1132. END;
  1133.  
  1134. {-------------------------------------------------------------------------}
  1135.  
  1136. PROCEDURE Parameter;
  1137. BEGIN
  1138.    GrMode := AllocString(80);
  1139.    SPMode := AllocString(80);
  1140.    DummyStr := AllocString(100);
  1141.    ReadStr := AllocString(100);
  1142.    Number := AllocString(100);
  1143.    NameEin := AllocString(100);
  1144.    NameAus := AllocString(100);
  1145.    NextName := AllocString(100);
  1146.    NextStore := AllocString(100);
  1147.    xkord := AllocString(4);
  1148.    ykord := AllocString(4);
  1149.    empty := AllocString(4);
  1150.    empty := "   ";
  1151.  
  1152.    WBSP := GetStartupMsg();
  1153.  
  1154.    IF WBSP <> nil THEN BEGIN                  {WB-Start}
  1155.       REPEAT
  1156.          WRITE('Geben Sie den Grafikmodus ein h(igh) oder l(ow): ');
  1157.          READLN(GrMode);
  1158.       UNTIL (stricmp(GrMode,"h")=0) OR (stricmp(GrMode,"l")=0);
  1159.       REPEAT
  1160.          WRITE('Geben Sie den Rechenmodus an f(ast) oder s(low): ');
  1161.          READLN(Spmode);
  1162.       UNTIL (stricmp(SpMode,"f")=0) OR (stricmp(SpMode,"s")=0);
  1163.    END ELSE BEGIN                             {CLI-Start}
  1164.       GetParam(1, GrMode);
  1165.       GetParam(2, SpMode);
  1166.    END;
  1167.  
  1168.    IF (stricmp(SpMode,"\0")=0) AND            {Try to read scriptfile}
  1169.       (stricmp(GrMode,"\0")<>0) THEN BEGIN
  1170.       NameEin := StrDup(GrMode);
  1171.       IF ReOpen(NameEin,Eingabe) THEN BEGIN
  1172.           CommLine := 0;
  1173.           Anzahl := 1;
  1174.           WHILE NOT EOF(Eingabe) DO BEGIN
  1175.             READLN(Eingabe,ReadStr);
  1176.             INC(CommLine);
  1177.             FOR i:= 1 TO Commands DO BEGIN
  1178.                IF NOT Test_f THEN BEGIN
  1179.                   Test_f := StrNieq(Command[i],ReadStr,strlen(Command[i]));
  1180.                   IF Test_f THEN Comm := i;
  1181.                END;
  1182.             END;
  1183.             IF NOT Test_f THEN Error(ReadStr,CommLine,1);
  1184.             ComPara(Comm,ReadStr);
  1185.             Test_f := FALSE;
  1186.          END;
  1187.       IF Anzahl = 1 THEN
  1188.          Error("Global",0,14);
  1189.       IF Smode = 0 THEN
  1190.          Error("Global",0,15);
  1191.       IF NOT Name_f THEN
  1192.          Error("Global",0,11);
  1193.       Close(Eingabe);
  1194.       Script_f := TRUE;
  1195.       Anzahl := Anzahl - 1;
  1196.       END ELSE BEGIN
  1197.          WRITELN('Could not open Scriptfile!');
  1198.          WRITELN;
  1199.          Usage;
  1200.       END;
  1201.    END;
  1202.  
  1203.    IF NOT Script_f THEN BEGIN
  1204.       IF (stricmp(GrMode,"h")=0) OR (stricmp(GrMode,"l")=0) THEN BEGIN
  1205.          IF (stricmp(SpMode,"f")=0) OR (stricmp(SpMode,"s")=0) THEN BEGIN
  1206.             IF stricmp(GrMode,"l")=0 THEN
  1207.                Smode:=1
  1208.             ELSE
  1209.                Smode:=2;
  1210.             IF stricmp(SpMode,"f")=0 THEN
  1211.                Fast:=1
  1212.             ELSE
  1213.                Fast:=2;
  1214.          END ELSE
  1215.             Usage;
  1216.       END ELSE
  1217.           Usage;
  1218.    END;
  1219. END;
  1220.  
  1221. {-------------------------------------------------------------------------}
  1222.  
  1223. PROCEDURE TextDef;    {Fak ist mir erst jetzt bekannt}
  1224. BEGIN
  1225.    OK.FrontPen := TRUNC(16.0/Fak);
  1226.    Cancel.FrontPen := TRUNC(16.0/Fak);
  1227.    Repair.FrontPen := TRUNC(16.0/Fak);
  1228.    Feintxt.FrontPen := TRUNC(16.0/Fak);
  1229. END;
  1230.  
  1231. {-------------------------------------------------------------------------}
  1232.  
  1233. PROCEDURE PointerDef;
  1234. BEGIN
  1235.    CrossData := AllocMem(68,MemChip);
  1236.    IF CrossData <> nil THEN BEGIN
  1237.       CrossData^ := CrossSt;
  1238.       SetPointer(bw,CrossData,15,16,-8,-7);
  1239.    END;
  1240. END;
  1241.  
  1242. {-------------------------------------------------------------------------}
  1243.  
  1244. PROCEDURE NewPicData;
  1245. BEGIN
  1246.    FOR i := 1 TO Anzahl DO BEGIN
  1247.       IF Anim_f[i] THEN BEGIN
  1248.          LadX[i] := AnisX[i]-((AnisX[i]-AnieX[i])/FLOAT(Frames))*FLOAT(PicNum);
  1249.          LadY[i] := AnisY[i]-((AnisY[i]-AnieY[i])/FLOAT(Frames))*FLOAT(PicNum);
  1250.          Lad[i] := Anis[i]-((Anis[i]-Anie[i])/FLOAT(Frames))*FLOAT(PicNum);
  1251.       END;
  1252.    END;
  1253. END;
  1254.  
  1255. {-------------------------------------------------------------------------}
  1256.  
  1257. PROCEDURE SetApkt;
  1258. BEGIN
  1259.    FOR t:=0 TO 8 DO BEGIN {t heißt eigentlich Atf, ist aber schon besetzt}
  1260.       Arbb[t]:=TRUNC(FLOAT(Minbr)*SPPow(8.0-FLOAT(t),2.0)); {2^(8-t)}
  1261.       Arbh[t]:=TRUNC(FLOAT(Minho)*SPPow(8.0-FLOAT(t),2.0));
  1262.       Arbfeld[t]:=1;
  1263.       Apktx[t]:=0;
  1264.       Apkty[t]:=0;
  1265.    END;
  1266. END;
  1267.  
  1268. {-------------------------------------------------------------------------}
  1269.  
  1270. PROCEDURE SetAtf;
  1271. BEGIN
  1272.    Atf := ModeFlag;
  1273. END;
  1274.  
  1275. {-------------------------------------------------------------------------}
  1276.  
  1277. PROCEDURE Init; {Programmstart wird vorbereitet}
  1278. BEGIN {Init}
  1279.    WRITELN;
  1280.    WRITELN('Aequipot V1.15 NTSC (June 28, 1991)');
  1281.    WRITELN('Copyright © 1990/91 Juergen Matern. All rights reserved.');
  1282.    WRITELN;
  1283.  
  1284.    PicNum := 1;
  1285.    Frames := 1;
  1286.    Minbr:=5;
  1287.    Minho:=4;
  1288.  
  1289.    Parameter;
  1290.  
  1291.    IF Smode=1 THEN BEGIN   {LoRes-Einstellungen}
  1292.       Sbreite:=320;
  1293.       Shoehe:=Skonst;
  1294.       Wbreite:=320;
  1295.       Whoehe:=Shoehe;
  1296.       Smode:=16384;      {LoRes=16384}
  1297.       ModeFlag:=2;
  1298.       SetAtf;
  1299.    END ELSE BEGIN        {HiRes-Einstellungen}
  1300.       Sbreite:=640;
  1301.       Shoehe:=2*Skonst;
  1302.       Wbreite:=640;
  1303.       Whoehe:=Shoehe;
  1304.       Smode:=32772;      {HiRes=32768 Lace=4}
  1305.       ModeFlag:=1;
  1306.       SetAtf;
  1307.    END;
  1308.  
  1309.    Fak:=(3.0-FLOAT(ModeFlag));
  1310.    xs:=Minbr*(3-ModeFlag);
  1311.    ys:=Minho*(3-ModeFlag);
  1312.  
  1313.    SetApkt;
  1314.    TextDef;
  1315.  
  1316.    Quit:=FALSE;
  1317. END; {Init}
  1318.  
  1319. {-------------------------------------------------------------------------}
  1320.  
  1321. BEGIN {MAIN}
  1322.    OpenMath;
  1323.    Init;
  1324.    OpenAll;
  1325.    InitFileReq;
  1326.    PointerDef;
  1327.    Color;
  1328.  
  1329.    REPEAT
  1330.       IF NOT Script_f THEN BEGIN
  1331.          LadKoord;
  1332.          LadGet;
  1333.       END ELSE BEGIN
  1334.          NewPicData;
  1335.          SetApkt;
  1336.          SetAtf;
  1337.       END;
  1338.  
  1339.       LadMark;
  1340.  
  1341.       NoHide:=TRUE;
  1342.       ShowTitle(s, NoHide);
  1343.  
  1344.       IF Fast=1 THEN
  1345.          FastDraw(0,0,640 DIV Modeflag,(Skonst*2) DIV Modeflag,xs,ys,FALSE)
  1346.       ELSE
  1347.          Areatest;
  1348.  
  1349.       IF (NOT Quit) AND
  1350.        (NOT Script_f) AND
  1351.        (Fast = 1) THEN BEGIN
  1352.          Reqflag:=AutoRequest(bw,ADR(Feintxt),ADR(OK),ADR(Cancel),0,0,257,60);
  1353.          IF ReqFlag THEN BEGIN
  1354.             NoHide:=TRUE;
  1355.             ShowTitle(s, NoHide);
  1356.             Clear;
  1357.             LadMark;
  1358.             AreaTest;
  1359.             Fast := 2;
  1360.          END;
  1361.       END;
  1362.  
  1363.       IF (NOT Quit) AND
  1364.        (NOT Script_f) AND
  1365.        (Fast = 2) THEN BEGIN
  1366.          NoHide:=FALSE;
  1367.          ShowTitle(s, NoHide);
  1368.          REPEAT
  1369.             Reqflag:=AutoRequest(bw,ADR(Repair),ADR(OK),ADR(Cancel),0,0,225,60);
  1370.             IF ReqFlag THEN BEGIN
  1371.                SetRepArea;
  1372.                RepairArea;
  1373.             END ELSE BEGIN
  1374.                NoHide:=TRUE;
  1375.                ShowTitle(s, NoHide);
  1376.             END;
  1377.          UNTIL ReqFlag = FALSE;
  1378.       END;
  1379.  
  1380.       IF NOT Quit THEN BEGIN
  1381.          IF Script_f THEN BEGIN
  1382.             ShowTitle(s, FALSE);
  1383.             NameAus := StrDup(NameStore);
  1384.             IF AnGlob_f THEN BEGIN
  1385.                Dummy := IntToStr(DummyStr,PicNum);
  1386.                StrCat(NameAus,DummyStr);
  1387.                FOR i:= 0 TO strlen(NameAus) DO
  1388.                   Answerarray[i] := NameAus[i];
  1389.                Answerarray[i+1] := '\0';
  1390.             END;
  1391.             ILBMError := SaveWindowToIFF(bw,ADR(Answerarray));
  1392.             IF ILBMError <> 0 THEN BEGIN
  1393.                SimpleRequest("Couldn't save picture!");
  1394.                Quit := TRUE;
  1395.                PicNum := Frames+1;
  1396.             END;
  1397.             IF NOT AnGlob_f THEN
  1398.                PicNum := Frames+1
  1399.             ELSE
  1400.                INC(PicNum);
  1401.          END ELSE
  1402.             PicNum := Frames+1;
  1403.       END ELSE
  1404.          PicNum := Frames+1;
  1405.    UNTIL PicNum = Frames+1;
  1406.  
  1407.    WHILE Quit=FALSE DO BEGIN
  1408.       ModifyIDCMP(bw, MOUSEBUTTONS_f + VANILLAKEYS_f);
  1409.       m:=WaitPort(bw^.UserPort);
  1410.       m:=WaitPort(bw^.UserPort);
  1411.       IF m <> nil THEN BEGIN
  1412.          HandleMessage;
  1413.       END;
  1414.    END;
  1415.  
  1416.    CloseAll;
  1417. END. {MAIN}
  1418.  
  1419. {-------------------------------------------------------------------------}
  1420.